perm filename MPOLD.F4[RST,LCS] blob
sn#233037 filedate 1976-08-22 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
C00011 ENDMK
C⊗;
C MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
C *** READS DATA FROM DSK FOR VARIOUS THINGS.
IMPLICIT INTEGER(A-Q,S-Z)
REAL DIS,DISX,A,B,STFF,CENTR,POS,BOT,TOP,TOP2,TOTAL
COMMON /DL/IXRX,SAVER,NAME /FRMT/F78F(1),FA1(1),FA5(1),ASK
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
C ↓↓↓↓↓ V IS FOR READIN ONLY
COMMON /XRN/RN(3000),V(1000) /ALF/INP(72),ML
1 /STF/RSTFAC(-3/4),RSTJ2 /POSI/STFF(-3/4),JJ2,POS
1 /PTR/PWDS(250),ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
1/PLTR/PLT,RHT,DIS
EQUIVALENCE (J3,JQ(1)),(J5,JQ(3)),(R5,RJQ(3)),(POS,IPOS)
1,(R6,RJQ(4)),(R7,RJQ(5)),(R9,RJQ(7)),(J10,JQ(8)),(RX3,RJQ(20))
1,(R4,RJQ(2)),(R3,RJQ(1)),(I1,INP(1)),(R8,RJQ(6))
DATA IP/'P'/,FA1/'( A1)'/
ITMS=0
CALL SEGFIX
C TO ENABLE MULTIPLE USE OF UPPER SEGMENT (TVR)
TOTAL=0
RPLT=-999.
C RPLT WILL BE FOR HEAVY STAFF LINES.
23 TYPE 21
21 FORMAT(' RESET BOTTOM? '$)
ACCEPT FA1,K
IF(K.EQ.'A')GO TO 124
IF(K.EQ.'P')GO TO 123
C TYPE 'P' FOR PRIM FONT ONLY. 'A' FOR ALL, IF RESET IS NEEDED.
GO TO 24
123 JFONT=-1
GO TO 23
124 JFONT=0
GO TO 23
24 IF(K.EQ.'N')GO TO 22
C 'Y' OR <CR>=ABSOLUTE LOW POINT OF FILE WILL BE AT
C STARTING PEN POS.
C 'N'= BOTTOM OF STAFF 0 WILL BE AT STARTING PEN POS.
TOP2=-999
RNOMOV=0
22 I1=0
C RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
2 TOP=-999
BOT=999
20 PLT=0
PLOTIT=0
CC PWDS(1)=1.
EDX=-1
CC DO 1402 K=-3,4
CC1402 RSTFAC(K)=1.
M=1
CC ITEM=0
CC I=1
GO TO 5504
11 CALL NOTWRT
57 IF(PLT)GO TO 6120
ITEM=ITEM+1
IF(EDX.EQ.-1)GO TO 77
IF(M.LT.I)GO TO 6120
77 IF(PLOTIT.EQ.-2)GO TO 2311
CZZ PWDS(ITEM+1)=I
5504 IF(I1.EQ.IP)GO TO 2311
I1=IP
INP(2)='X'
311 JA=0
CC IF(I1.NE.IP)GO TO 85
2311 CALL PLTCMD
IF(INP(2).EQ.-1)GO TO 30
IF(PLOTIT.EQ.0)GO TO 3005
I1=IP
PLOTIT=-1
C 'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
6531 M=1
EDX=-1
DO 5532 K=1,9
5532 JQ(K)=RJQ(K)
CC590 IF(PLOTIT.EQ.-1)GO TO 121
IF(PLOTIT.EQ.-1)GO TO 5121
590 I1=0
C TO RUN THROUGH DATA.
CC243 R2=0
CC R3=0
CC R4=0
TOP=-999
BOT=999
C GOES TO PLOTTER
85 M=1
CC I=PWDS(ITEM+1)
ITEM=0
8852 PLT=1
EDX=0
GO TO 6120
30 A=TOTAL/200.0
TYPE 300,A,ITMS
CALL PLOT(0,0,99)
C THE END OF THE DATA
300 FORMAT(F7.2,' INCHES',I,' ITEMS')
60 J2=R2
IF(J2.LT.5)GO TO 16
IF(J2.GT.-4)GO TO 16
TYPE 160,J2
GO TO 57
160 FORMAT(' ILLEGAL STAFF# ',I4)
16 RSTJ2=RSTFAC(J2)
5541 POS=STFF(J2)
IF(JA.NE.16)GO TO 61
IF(R5.GE.100)R5=R5-100
C >100 FOR TEXT IN ORCH SCORES TO GO IN ALL SEPPPARTS.c
IF(J10.NE.1)GO TO 62
R3=RWD3
C POSITIONS TEXT ITEMS.
62 RWD3=R5*RSTJ2*R9+R3
61 RX3=R3
J3=ROFF(RHORZ(R3))
C LINE IS DIVIDED INTO 200 POINTS.
CALL CENTX
C SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
R3=J3
IF(JA.LE.2)GO TO 11
551 GO TO(11,11,68,25,67, 625,116,125,11,69, 68,67),JA
GO TO (116,81,80),JA-15
C FOR 16,17,18 (WORDS, KSIG, METER)
TYPE 5700,JA
5700 FORMAT(' UNKNOWN CODE=',I3)
GO TO 57
C TRAP FOR UNKNOWN CODE #S (SUCH AS 99 - FOR "NO KSIG".
69 CALL MAKNUM(R5)
GO TO 57
68 CALL CLEFS
GO TO 57
67 CALL SLUR
GO TO 57
116 CALL ALPHA
GO TO 57
81 CALL KSIG
GO TO 57
80 CALL METER
GO TO 57
125 IF(R2.EQ.0)RMOV=R8
625 CALL BMSTF
C BEAMS AND STAVES
GO TO 57
25 CALL ITMSUB
C BAR LINES AND SEVERAL OTHER KINDS OF LINES.
GO TO 57
CC3005 REWIND 21
C GUARDS AGAINST LOSSAGE!
3005 IF(RPLT.EQ.-999.)RPLT=R9
C R9=1 FOR HEAVY STAFF LINES. (FOR XGP)
PLOTIT=-2
CC CALL IFILE(21,NAME)
CALL GETFI2(NAME,-1)
C JUMP TO READ BIG FILES
CC2200 J=ITEM+1
CALL FASTI2(RSTFAC,128)
CALL FASTI2(PWDS,JJ2)
CALL FASTI2(RN,IPOS)
ITEM=JJ2-2
ITMS=ITMS+ITEM
I=IPOS
CC2202 READ(21),ITEM,I,(PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1)
CC 1 ,JA,(V(K),K=1,JA),JA,(V(K),K=1,JA),RSTFAC,STFF
CC READ(21,END=2203)RSTFAC,STFF
2203 IF(I.LE.2000)GO TO 590
TYPE 4202,Y
STOP
4202 FORMAT(' ***** TOO MUCH DATA ',I4,'/2000')
121 IF(PLOTIT.EQ.0)GO TO 5504
5121 CALL PLTSRT
C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
PLT=-1
IF(RPLT.NE.0)PLT=-2
C (J8) P8=1 OR 2 FOR 2-PASS PLOTS
CC IF(R2.EQ.0)R2=1.
CALL NOZERO(R2)
DIS=R2*1.24
CXX IF(R3.EQ.0)R3=R2
RHT=R3*1.2
C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
A=BOT*RHT
BOT=-A
TOTAL=TOTAL+BOT+TOP*RHT
CX IXGP=100+BOT
IF(TOP2.EQ.-999)GO TO 8121
BOT=BOT+TOP2
IF(TOP2.EQ.0)BOT=0
A=BOT
GO TO 9121
8121 RNOMOV=0
9121 IF(R7.EQ.0)R7=RMOV
C RMOV HAS INCHES FROM P8 OF STAFF 0.
IF(RNOMOV.GT.1)BOT=RNOMOV
RNOMOV=R6+R7*200.*R3
RMOV=0
C R6=1 FOR NO MOVE AT END. R7=# OF INCHES TO MOVE FOR NEW STAFF 0.
C (J4) P4=1 FOR XGP OUTPUT
IF(J5.NE.0)GO TO 6120
C MOVES 0 POINT OVER EACH TIME.
6121 CALL PLOT(0,IFIX(BOT),-3)
C MOVES PLOTTER UP IF P5=0.
C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
6120 IF(M.GE.I)GO TO 7120
CALL RUNTHR(M)
GO TO 60
7120 M=1
71201 A=50.*RHT
TOP=TOP*RHT
IF(RNOMOV.EQ.0)GO TO 7122
A=0
7121 IF(RNOMOV.LE.1)GO TO 7123
A=RNOMOV
TOTAL=TOTAL+A-TOP
GO TO 7123
7122 TOTAL=TOTAL+A
A=A+TOP
7123 CALL PLOT(0,IFIX(A),3)
IF(RNOMOV.EQ.1)GO TO 20
C PRESERVES TOP AND BOT IF RNOMOV
TOP=A
TOP2=TOP
GO TO 2
C TO MOVE 'PLOTTER' FOR XGP OUTPUT
C MOVES PLOTTER UP
C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
END